home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mblast32 / data.z / SMALLCAP.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-07  |  7.5 KB  |  221 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   3000
  5.    ClientLeft      =   3060
  6.    ClientTop       =   1560
  7.    ClientWidth     =   3180
  8.    ClipControls    =   0   'False
  9.    ControlBox      =   0   'False
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   0
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    Height          =   3345
  20.    Icon            =   "SMALLCAP.frx":0000
  21.    KeyPreview      =   -1  'True
  22.    Left            =   3030
  23.    LinkTopic       =   "Form1"
  24.    MaxButton       =   0   'False
  25.    MinButton       =   0   'False
  26.    ScaleHeight     =   3000
  27.    ScaleWidth      =   3180
  28.    Top             =   1245
  29.    Width           =   3240
  30.    Begin VB.CommandButton Command1 
  31.       Caption         =   "Quit"
  32.       Height          =   372
  33.       Left            =   1860
  34.       TabIndex        =   0
  35.       Top             =   2520
  36.       Width           =   972
  37.    End
  38.    Begin MessageBlaster.MsgBlaster MsgBlaster1 
  39.       Left            =   240
  40.       Top             =   2460
  41.       _version        =   65536
  42.       _extentx        =   847
  43.       _extenty        =   847
  44.       _stockprops     =   0
  45.       enabled         =   -1  'True
  46.       voodoo          =   "SMALLCAP.frx":000C
  47.    End
  48.    Begin VB.Label Label3 
  49.       Caption         =   "Try using the system menu. You'll find the about box there."
  50.       Height          =   375
  51.       Left            =   120
  52.       TabIndex        =   3
  53.       Top             =   1980
  54.       Width           =   3015
  55.    End
  56.    Begin VB.Label Label2 
  57.       Caption         =   "How to create a small caption in Visual Basic"
  58.       Height          =   435
  59.       Left            =   120
  60.       TabIndex        =   2
  61.       Top             =   180
  62.       Width           =   3015
  63.    End
  64.    Begin VB.Label Label1 
  65.       Caption         =   $"SMALLCAP.frx":12DC
  66.       Height          =   1215
  67.       Left            =   120
  68.       TabIndex        =   1
  69.       Top             =   660
  70.       Width           =   3015
  71.    End
  72. Attribute VB_Name = "frmMain"
  73. Attribute VB_Creatable = False
  74. Attribute VB_Exposed = False
  75. Option Explicit
  76. 'Virtual Key values
  77. Const VK_ESCAPE = &H1B
  78. 'System Metrics Constants
  79. Const SM_CYMENU = 15
  80. 'SysCommand, wParam values
  81. Const SC_MOVE = &HF010
  82. Const SC_CLOSE = &HF060
  83. 'Menu Function values
  84. Const MF_SEPARATOR = &H800
  85. Const MF_ENABLED = 0
  86. Const MF_STRING = 0
  87. Const MF_BmyPosITION = 400
  88. 'Menu ID's
  89. Const IDM_SYSMOVE = 101
  90. Const IDM_SYSCLOSE = 102
  91. Const IDM_ABOUT = 103
  92. 'MsgBlaster property values
  93. Const PREPROCESS = -1
  94. Const EATMESSAGE = 0
  95. Const POSTPROCESS = 1
  96. 'WM_NCHITTEST return values
  97. Const HTCLIENT = 1
  98. Const HTCAPTION = 2
  99. Const HTSYSMENU = 3
  100. Dim mFormTop%
  101. Dim mFormLeft%
  102. Dim mxPos%
  103. Dim myPos%
  104. Dim mCaptionColor&
  105. Dim mhSysMenu As Long
  106. Dim mScreenRect As RECT
  107. Dim mInSysMenu As Integer
  108. Private Sub Command1_Click()
  109.     End
  110. End Sub
  111. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  112.   If (KeyCode = 115) And (Shift = 4) Then End
  113.   If (KeyCode = 18) And (Shift = 0) Then ShowSysMenu
  114.   If (KeyCode = 27) And (Shift = 0) Then mInSysMenu = False
  115. End Sub
  116. Private Sub Form_Load()
  117.     Dim rc%
  118.     Me.ScaleMode = 3
  119.     mCaptionColor& = GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF
  120.     mhSysMenu = CreatePopupMenu()
  121.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSMOVE, "&Move")
  122.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_SYSCLOSE, "&Close  Alt+F4")
  123.     rc% = AppendMenu(mhSysMenu, MF_SEPARATOR, 0, "")
  124.     rc% = AppendMenu(mhSysMenu, MF_ENABLED Or MF_STRING, IDM_ABOUT, "&About")
  125.     mScreenRect.left = 0
  126.     mScreenRect.right = Screen.Width / Screen.TwipsPerPixelX
  127.     mScreenRect.top = 0
  128.     mScreenRect.bottom = Screen.Height / Screen.TwipsPerPixelY
  129.     Msgblaster1.hWndTarget = frmMain.hWnd
  130.     Msgblaster1.AddMessage WM_CLOSE, POSTPROCESS
  131.     Msgblaster1.AddMessage WM_COMMAND, POSTPROCESS
  132.     Msgblaster1.AddMessage WM_NCACTIVATE, POSTPROCESS
  133.     Msgblaster1.AddMessage WM_NCHITTEST, EATMESSAGE
  134.     Msgblaster1.AddMessage WM_NCLBUTTONDBLCLK, EATMESSAGE
  135.     Msgblaster1.AddMessage WM_NCLBUTTONDOWN, POSTPROCESS
  136. End Sub
  137. Private Sub Form_Paint()
  138.   'Paint caption background
  139.   Line (0, -1)-Step(Me.Width, 9), mCaptionColor&, BF
  140.   'Horizontal line under caption
  141.   Line (0, 8)-Step(Me.ScaleWidth, 0), QBColor(0)
  142.   'Vertical line beteen control menu and caption
  143.   Line (10, 0)-Step(0, 8), QBColor(0)
  144.   'Background for control menu
  145.   Line (0, 0)-Step(9, 7), QBColor(7), BF
  146.   'Box for bar in control menu
  147.   Line (2, 2)-Step(5, 2), QBColor(0), B
  148.   'Line inside bar in control menu
  149.   Line (3, 3)-Step(4, 0), QBColor(15)
  150.   'Vertical shadow on bar in control menu
  151.   Line (8, 3)-Step(0, 3), QBColor(8)
  152.   'Horizontal shadow on bar in control menu
  153.   Line (3, 5)-Step(5, 0), QBColor(8)
  154. End Sub
  155. Private Sub ShowSysMenu()
  156.     Dim InPixels%
  157.     Dim x%, y%, rc%
  158.     InPixels = Me.ScaleWidth
  159.     Me.ScaleMode = 1
  160.     x = (left) \ (Me.ScaleWidth \ InPixels)
  161.     y = (9 * Screen.TwipsPerPixelY + (Me.top + (Me.Height - Me.ScaleHeight - (Me.Width - Me.ScaleWidth)))) \ (Me.ScaleWidth \ InPixels)
  162.     ScaleMode = 3
  163.     If (y + (3 * GetSystemMetrics(SM_CYMENU))) > (Screen.Height / Screen.TwipsPerPixelY) Then
  164.         rc% = TrackPopupMenu(mhSysMenu, 0, x, y - (3 * GetSystemMetrics(SM_CYMENU)) - 9, 0, Me.hWnd, mScreenRect)
  165.     Else
  166.         rc% = TrackPopupMenu(mhSysMenu, 0, x, y, 0, Me.hWnd, mScreenRect)
  167.     End If
  168.     mInSysMenu = True
  169. End Sub
  170. Private Sub Msgblaster1_Message(ByVal hWnd As Long, ByVal Msg As Long, wParam As Long, lParam As Long, nPassage As Integer, lReturnValue As Long)
  171.    Dim rc&
  172.     Select Case Msg
  173.         Case WM_NCACTIVATE
  174.             If wParam Then
  175.                 mCaptionColor = GetSysColor(COLOR_ACTIVECAPTION) And &HFFFFFF
  176.             Else
  177.                 mCaptionColor = GetSysColor(COLOR_INACTIVECAPTION) And &HFFFFFF
  178.             End If
  179.             Me.Refresh
  180.         Case WM_CLOSE
  181.             End
  182.         Case WM_NCHITTEST
  183.             mxPos = (lParam And &HFFFF&)
  184.             myPos = (lParam / 65536)
  185.             mFormTop = top / Screen.TwipsPerPixelY
  186.             mFormLeft = left / Screen.TwipsPerPixelX
  187.             If (myPos - mFormTop < 10) And (mxPos - mFormLeft > 10) Then
  188.                 lReturnValue = HTCAPTION
  189.                 mInSysMenu = False
  190.             ElseIf (myPos - mFormTop < 10) And (mxPos - mFormLeft < 10) Then
  191.                 lReturnValue = HTSYSMENU
  192.                 'mInSysMenu = True
  193.             Else
  194.                 lReturnValue = HTCLIENT
  195.                 mInSysMenu = False
  196.             End If
  197.         Case WM_NCLBUTTONDBLCLK
  198.             If wParam = HTSYSMENU Then
  199.                 End
  200.             End If
  201.         Case WM_NCLBUTTONDOWN
  202.             If wParam = HTSYSMENU Then
  203.                 If mInSysMenu Then
  204.                     mInSysMenu = False
  205.                     Exit Sub
  206.                 Else
  207.                     ShowSysMenu
  208.                 End If
  209.             End If
  210.         Case WM_COMMAND
  211.             Select Case wParam
  212.                 Case IDM_SYSMOVE
  213.                     rc& = SendMessage(hWnd, WM_SYSCOMMAND, SC_MOVE, 0)
  214.                 Case IDM_SYSCLOSE
  215.                     End
  216.                 Case IDM_ABOUT
  217.                     frmAbout.Show vbModal
  218.             End Select
  219.     End Select
  220. End Sub
  221.